# 05_jes2005_wave8.R
# Purpose: Ideological Extremism and Political Participation in Japan
# Created: 2020-5-16 Taka-aki Asano
# Last Modified: 2021-10-9

# package
require("haven")
require("dplyr")
require("ltm")
require("plink")


# dataset
JES2005 <- read.table(
  "JESIII/Japanese/0530β.dat", 
  header = TRUE, sep = "\t", quote = "\"", comment.char = ""
)
JES2005$ID <- 1:nrow(JES2005)


# respondent
JES2005_Respondent <- JES2005[,c("ID", paste0("J", c(19:26, 28), "S1"))]
colnames(JES2005_Respondent)[-1] <- paste0("q", c(19:26, 28))
JES2005_Respondent <- apply(JES2005_Respondent, c(1, 2), 
                            function(x) {
                              if(x%in%c(8, 9)) {x <- NA} 
                              else {x <- x}}
) %>% as.data.frame()


# IRT
## handle missing data
JES2005_Respondent <- JES2005_Respondent[rowSums(JES2005_Respondent[,-1], na.rm = TRUE) != 0,]

## estimate item parameters
irt2005 <- ltm::grm(JES2005_Respondent[,-1], IRT.param = FALSE)
irt2005 ## viewing

## estimate voters ideology
score2005_Respondent <- ltm::factor.scores(irt2005, JES2005_Respondent[,-1])


# rescale
## common item
common2012 <- c("q8", "q9", "q10", "q12", "q13", "q14")
common2005 <- c("q19", "q20", "q21", "q23", "q24", "q25")
index <- data.frame(
  group1 = match(common2012, colnames(JES2012_Respondent[,-1])), 
  group2 = match(common2005, colnames(JES2005_Respondent[,-1]))
)

## list of parameters
### 2012
res2012 <- coef(irt2012)
res2012 <- res2012[,c(4,1:3)]
colnames(res2012) <- c("a","b1","b2","b3")
### 2005
res2005 <- coef(irt2005)
res2005 <- res2005[,c(4,1:3)]
colnames(res2005) <- c("a","b1","b2","b3")
### merge
pm <- list(res2012, res2005)

## list of scale
rescat <- list(rep(4, nrow(res2012)), 
               rep(4, nrow(res2005)))

## as.irt.pars
pm2012 <- as.poly.mod(n = nrow(res2012), model = "grm", 
                      items = 1:nrow(res2012))
pm2005 <- as.poly.mod(n = nrow(res2005), model = "grm", 
                      items = 1:nrow(res2005))
res <- as.irt.pars(pm, common = index, cat = rescat, 
                   poly.mod = list(pm2012, pm2005), 
                   location = FALSE)

## list of voters' position
ideology <- list(score2012_Respondent$score.dat$z1, 
                 score2005_Respondent$score.dat$z1)

## rescale
plink_out <- plink(res, common = index, base.grp = 1, 
                   rescale = "MM", ability = ideology)
summary(plink_out)

## estimate voters ideology (rescale)
score2005_Respondent_plink <- link.ability(plink_out)$group2
JES2005_Respondent$Ideology <- -1 * score2005_Respondent_plink


# LDP's position
JES2005_LDP <- JES2005[,c("ID", paste0("J", c(19:26, 28), "S3X1"))]
colnames(JES2005_LDP)[-1] <- paste0("q", c(19:26, 28))
JES2005_LDP <- apply(JES2005_LDP, c(1, 2), 
                     function(x) {
                       if(x%in%c(8, 9)) {x <- NA}
                       else {x <- x}}
) %>% as.data.frame()
JES2005_LDP <- JES2005_LDP[rowSums(JES2005_LDP[,-1], na.rm = TRUE) != 0,]
score2005_LDP <- ltm::factor.scores(irt2005, JES2005_LDP[,-1])
ideology <- list(score2012_Respondent$score.dat$z1, 
                 score2005_LDP$score.dat$z1)
plink_out <- plink(res, common = index, base.grp = 1, 
                   rescale = "MM", ability = ideology)
JES2005_LDP$Ideology <- -1 * link.ability(plink_out)$group2


# DPJ's position
JES2005_DPJ <- JES2005[,c("ID", paste0("J", c(19:26, 28), "S3X2"))]
colnames(JES2005_DPJ)[-1] <- paste0("q", c(19:26, 28))
JES2005_DPJ <- apply(JES2005_DPJ, c(1, 2), 
                     function(x) {
                       if(x%in%c(8, 9)) {x <- NA}
                       else {x <- x}}
) %>% as.data.frame()
JES2005_DPJ <- JES2005_DPJ[rowSums(JES2005_DPJ[,-1], na.rm = TRUE) != 0,]
score2005_DPJ <- ltm::factor.scores(irt2005, JES2005_DPJ[,-1])
ideology <- list(score2012_Respondent$score.dat$z1, 
                 score2005_DPJ$score.dat$z1)
plink_out <- plink(res, common = index, base.grp = 1, 
                   rescale = "MM", ability = ideology)
JES2005_DPJ$Ideology <- -1 * link.ability(plink_out)$group2
